home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / find.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  12.6 KB  |  397 lines
  1. /* find.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal cpyknt;
  40.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  41.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  42.         nwd16;
  43. } memmgr_;
  44.  
  45. #define memmgr_1 memmgr_
  46.  
  47. struct {
  48.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  49.         sfactr;
  50.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  51.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  52. } status_;
  53.  
  54. #define status_1 status_
  55.  
  56. struct {
  57.     doublereal value[200000];
  58. } blank_;
  59.  
  60. #define blank_1 blank_
  61.  
  62. /* Table of constant values */
  63.  
  64. static integer c__1 = 1;
  65.  
  66. /*<       subroutine find(aname,id,loc,iforce) >*/
  67. /* Subroutine */ int find_(aname, id, loc, iforce)
  68. doublereal *aname;
  69. integer *id, *loc, *iforce;
  70. {
  71.     /* Initialized data */
  72.  
  73.     static integer lnod[50] = { 10,14,16,8,15,16,15,16,13,8,18,38,27,35,8,8,
  74.         35,5,5,5,5,5,5,5,0,0,0,0,0,0,21,21,21,21,21,21,21,21,21,21,8,8,8,
  75.         8,8,0,0,0,0,0 };
  76.     static integer lval[50] = { 5,4,4,2,1,1,1,1,4,4,3,4,4,16,1,1,9,2,1,1,19,
  77.         55,17,46,0,0,0,0,0,0,1,1,1,1,1,17,17,17,17,17,1,1,1,1,1,0,0,0,0,0 
  78.         };
  79.     static struct {
  80.     char e_1[4];
  81.     integer e_2;
  82.     } equiv_16 = { {'.', 'u', ' ', ' '}, 0 };
  83.  
  84. #define ndefin (*(integer *)&equiv_16)
  85.  
  86.  
  87.     /* Format strings */
  88.     static char fmt_26[] = "(\0020*error*:  above line attempts to redefine\
  89.  \002,a8/)";
  90.  
  91.     /* System generated locals */
  92.     integer i_1;
  93.  
  94.     /* Builtin functions */
  95.     integer s_wsfe(), do_fio(), e_wsfe();
  96.  
  97.     /* Local variables */
  98.     static doublereal anam;
  99.     static integer locn, loct, locv, ktmp, iptr;
  100.     extern integer xxor_();
  101.     extern /* Subroutine */ int zero4_(), zero8_();
  102.     static integer itemp, isize, nword;
  103. #define nodplc ((integer *)&blank_1)
  104. #define cvalue ((complex *)&blank_1)
  105.     extern /* Subroutine */ int sizmem_();
  106.     extern integer nxtevn_();
  107.     extern /* Subroutine */ int extmem_(), undefi_();
  108.  
  109.     /* Fortran I/O blocks */
  110.     static cilist io__11 = { 0, 0, 0, fmt_26, 0 };
  111.  
  112.  
  113. /*<       implicit double precision (a-h,o-z) >*/
  114.  
  115. /*     this routine searches the list with number 'id' for an element */
  116. /* with name 'aname'.  loc is set to point to the element.  if iforce is 
  117. */
  118. /* nonzero, then find expects to have to add the element to the list, and 
  119. */
  120. /* reports a fatal error if the element is found.  if subcircuit defini- 
  121. */
  122. /* tion is in progress (nonzero value for nsbckt), then find searches the 
  123. */
  124. /* current subcircuit definition list rather than the nominal element */
  125. /* list. */
  126.  
  127. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  128. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  129. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  130. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  131. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  132. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  133. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  134. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  135. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  136. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  137. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  138. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  139. /* spice version 2g.6  sccsid=flags 3/15/83 */
  140. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  141. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  142. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  143. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  144. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  145. /*<      2   nwd8,nwd16 >*/
  146. /* spice version 2g.6  sccsid=status 3/15/83 */
  147. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  148. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  149. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  150. /* spice version 2g.6  sccsid=blank 3/15/83 */
  151. /*<       common /blank/ value(200000) >*/
  152. /*<       integer nodplc(64) >*/
  153. /*<       complex cvalue(32) >*/
  154. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  155.  
  156. /*  index to the contents of the various lists: */
  157.  
  158. /*        list      contents */
  159. /*        ----      -------- */
  160.  
  161. /*          1       resistors */
  162. /*          2       nonlinear capacitors */
  163. /*          3       nonlinear inductors */
  164. /*          4       mutual inductors */
  165. /*          5       nonlinear voltage controlled current sources */
  166. /*          6       nonlinear voltage controlled voltage sources */
  167. /*          7       nonlinear current controlled current sources */
  168. /*          8       nonlinear current controlled voltage sources */
  169. /*          9       independent voltage sources */
  170. /*         10       independent current sources */
  171. /*         11       diodes */
  172. /*         12       bipolar junction transistors */
  173. /*         13       junction field-effect transistors (jfets) */
  174. /*         14       metal-oxide-semiconductor junction fets (mosfets) */
  175. /*         15       s-parameter 2-port network */
  176. /*         16       y-parameter 2-port network */
  177. /*         17       transmission lines */
  178. /*         18       used for temperature sweeping */
  179. /*         19       subcircuit calls */
  180. /*         20       subcircuit definitions */
  181. /*         21       diode model */
  182. /*         22       bjt model */
  183. /*         23       jfet model */
  184. /*         24       mosfet model */
  185. /*      25-30       <unused> */
  186. /*         31       .print dc */
  187. /*         32       .print tran */
  188. /*         33       .print ac */
  189. /*         34       .print noise */
  190. /*         35       .print distortion */
  191. /*         36       .plot dc */
  192. /*         37       .plot tr */
  193. /*         38       .plot ac */
  194. /*         39       .plot noise */
  195. /*         40       .plot distortion */
  196. /*         41       outputs for dc */
  197. /*         42       outputs for transient */
  198. /*         43       outputs for ac */
  199. /*         44       outputs for noise */
  200. /*         45       outputs for distortion */
  201. /*      46-50       <unused> */
  202.  
  203. /*<       integer xxor >*/
  204. /*<       dimension lnod(50),lval(50) >*/
  205. /*<       data lnod /10,14,16, 8,15,16,15,16,13, 8, >*/
  206. /*<      1           18,38,27,35, 8, 8,35, 5, 5, 5, >*/
  207. /*<      2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0, >*/
  208. /*<      3           21,21,21,21,21,21,21,21,21,21, >*/
  209. /*<      4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 / >*/
  210. /*<       data lval / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4, >*/
  211. /*<      1            3, 4, 4,16, 1, 1, 9, 2, 1, 1, >*/
  212. /*<      2           19,55,17,46, 0, 0, 0, 0, 0, 0, >*/
  213. /*<      3            1, 1, 1, 1, 1,17,17,17,17,17, >*/
  214. /*<      4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 / >*/
  215. /*<       data ndefin /2h.u/ >*/
  216.  
  217.  
  218. /*<       anam=aname >*/
  219.     anam = *aname;
  220. /*<       call sizmem(ielmnt,isize) >*/
  221.     sizmem_(&tabinf_1.ielmnt, &isize);
  222. /*<       locn=ielmnt+isize+2 >*/
  223.     locn = tabinf_1.ielmnt + isize + 2;
  224. /*<       if (nsbckt.eq.0) go to 10 >*/
  225.     if (tabinf_1.nsbckt == 0) {
  226.     goto L10;
  227.     }
  228. /*<       loct=nodplc(isbckt+nsbckt) >*/
  229.     loct = nodplc[tabinf_1.isbckt + tabinf_1.nsbckt - 1];
  230. /*<       loc=nodplc(loct+3) >*/
  231.     *loc = nodplc[loct + 2];
  232. /*<       if (loc.ne.0) go to 20 >*/
  233.     if (*loc != 0) {
  234.     goto L20;
  235.     }
  236. /*<       nodplc(loct+3)=locn >*/
  237.     nodplc[loct + 2] = locn;
  238. /*<       go to 60 >*/
  239.     goto L60;
  240. /*<    10 loc=locate(id) >*/
  241. L10:
  242.     *loc = cirdat_1.locate[*id - 1];
  243. /*<       if (loc.ne.0) go to 20 >*/
  244.     if (*loc != 0) {
  245.     goto L20;
  246.     }
  247. /*<       locate(id)=locn >*/
  248.     cirdat_1.locate[*id - 1] = locn;
  249. /*<       go to 50 >*/
  250.     goto L50;
  251.  
  252. /*  search list for a name match */
  253.  
  254. /*<    20 locv=nodplc(loc+1) >*/
  255. L20:
  256.     locv = nodplc[*loc];
  257. /*<       if (xxor(anam,value(locv)).ne.0) go to 30 >*/
  258.     if (xxor_(&anam, &blank_1.value[locv - 1]) != 0) {
  259.     goto L30;
  260.     }
  261. /*<       if (numalt.ne.0) go to 30 >*/
  262.     if (cirdat_1.numalt != 0) {
  263.     goto L30;
  264.     }
  265. /*<       if (nsbckt.eq.0) go to 25 >*/
  266.     if (tabinf_1.nsbckt == 0) {
  267.     goto L25;
  268.     }
  269. /*<       if (nodplc(loc-1).ne.id) go to 30 >*/
  270.     if (nodplc[*loc - 2] != *id) {
  271.     goto L30;
  272.     }
  273. /*<    25 if (nodplc(loc+2).eq.ndefin) go to 200 >*/
  274. L25:
  275.     if (nodplc[*loc + 1] == ndefin) {
  276.     goto L200;
  277.     }
  278. /*<       if (iforce.eq.0) go to 200 >*/
  279.     if (*iforce == 0) {
  280.     goto L200;
  281.     }
  282. /*<       write (iofile,26) anam >*/
  283.     io__11.ciunit = status_1.iofile;
  284.     s_wsfe(&io__11);
  285.     do_fio(&c__1, (char *)&anam, (ftnlen)sizeof(doublereal));
  286.     e_wsfe();
  287. /*<    26 format('0*error*:  above line attempts to redefine ',a8/) >*/
  288. /*<       nogo=1 >*/
  289.     flags_1.nogo = 1;
  290. /*<    30 if (nodplc(loc).eq.0) go to 40 >*/
  291. L30:
  292.     if (nodplc[*loc - 1] == 0) {
  293.     goto L40;
  294.     }
  295. /*<       loc=nodplc(loc) >*/
  296.     *loc = nodplc[*loc - 1];
  297. /*<       go to 20 >*/
  298.     goto L20;
  299.  
  300. /*  reserve space for this element */
  301.  
  302. /*<    40 nodplc(loc)=locn >*/
  303. L40:
  304.     nodplc[*loc - 1] = locn;
  305. /*<       if (nsbckt.ne.0) go to 60 >*/
  306.     if (tabinf_1.nsbckt != 0) {
  307.     goto L60;
  308.     }
  309. /*<    50 if (numalt.eq.0) jelcnt(id)=jelcnt(id)+1 >*/
  310. L50:
  311.     if (cirdat_1.numalt == 0) {
  312.     ++cirdat_1.jelcnt[*id - 1];
  313.     }
  314. /*<    60 loc=locn >*/
  315. L60:
  316.     *loc = locn;
  317. /*<       itemp=loc+lnod(id)*nwd4-1 >*/
  318.     itemp = *loc + lnod[*id - 1] * memmgr_1.nwd4 - 1;
  319. /*<       locv=nxtevn(itemp-1)+1 >*/
  320.     i_1 = itemp - 1;
  321.     locv = nxtevn_(&i_1) + 1;
  322. /*<       itemp=locv-itemp >*/
  323.     itemp = locv - itemp;
  324. /*<       ktmp=lnod(id)*nwd4+lval(id)*nwd8+itemp >*/
  325.     ktmp = lnod[*id - 1] * memmgr_1.nwd4 + lval[*id - 1] * memmgr_1.nwd8 + 
  326.         itemp;
  327. /*<       call extmem(ielmnt,ktmp) >*/
  328.     extmem_(&tabinf_1.ielmnt, &ktmp);
  329. /*<       locv=(locv-1)/nwd8+1 >*/
  330.     locv = (locv - 1) / memmgr_1.nwd8 + 1;
  331. /*<       iptr=0 >*/
  332.     iptr = 0;
  333. /*<       if (nsbckt.eq.0) go to 80 >*/
  334.     if (tabinf_1.nsbckt == 0) {
  335.     goto L80;
  336.     }
  337. /*<       iptr=id >*/
  338.     iptr = *id;
  339. /*<    80 if (id.le.24) nodplc(loc+lnod(id)-2)=numalt >*/
  340. L80:
  341.     if (*id <= 24) {
  342.     nodplc[*loc + lnod[*id - 1] - 3] = cirdat_1.numalt;
  343.     }
  344. /*<       nodplc(loc-1)=iptr >*/
  345.     nodplc[*loc - 2] = iptr;
  346. /*<       nodplc(loc)=0 >*/
  347.     nodplc[*loc - 1] = 0;
  348. /*<       nodplc(loc+1)=locv >*/
  349.     nodplc[*loc] = locv;
  350. /*<       value(locv)=anam >*/
  351.     blank_1.value[locv - 1] = anam;
  352.  
  353. /*  background storage */
  354.  
  355. /*<   100 nodplc(loc+2)=ndefin >*/
  356. /* L100: */
  357.     nodplc[*loc + 1] = ndefin;
  358. /*<       nword=lnod(id)-4 >*/
  359.     nword = lnod[*id - 1] - 4;
  360. /*<       if (id.le.24) nword=nword-1 >*/
  361.     if (*id <= 24) {
  362.     --nword;
  363.     }
  364. /*<       if (nword.lt.1) go to 120 >*/
  365.     if (nword < 1) {
  366.     goto L120;
  367.     }
  368. /*<       call zero4(nodplc(loc+3),nword) >*/
  369.     zero4_(&nodplc[*loc + 2], &nword);
  370. /*<   120 nword=lval(id)-1 >*/
  371. L120:
  372.     nword = lval[*id - 1] - 1;
  373. /*<       if (nword.lt.1) go to 200 >*/
  374.     if (nword < 1) {
  375.     goto L200;
  376.     }
  377. /*<       call zero8(value(locv+1),nword) >*/
  378.     zero8_(&blank_1.value[locv], &nword);
  379. /*<       if ((id.ge.21).and.(id.le.24)) call undefi(value(locv+1),nword) >*/
  380.     if (*id >= 21 && *id <= 24) {
  381.     undefi_(&blank_1.value[locv], &nword);
  382.     }
  383.  
  384. /*  exit */
  385.  
  386. /*<   200 return >*/
  387. L200:
  388.     return 0;
  389. /*<       end >*/
  390. } /* find_ */
  391.  
  392. #undef cvalue
  393. #undef nodplc
  394. #undef ndefin
  395.  
  396.  
  397.